Tricks of the Mac Game Programming Gurus/TricksOfTheMacGameProgrammingGurus.iso/More Source/Pascal/Book Demos in Pascal/HexGridPlus/HexGrid.p

Text File | 1995-06-08 | 6.1 KB | 254 lines | [TEXT/PJMM]

program HexGrid;

{$IFC UNDEFINED THINK_PASCAL}
    uses
        Types, QuickDraw, Fonts, Events, Packages, Menus, Dialogs, Windows,{}
        OSUtils, ToolUtils, OSEvents;
{$ENDC}


    const
(*Size of the array*)
        kArraySizeH = 10;
        kArraySizeV = 8;

    var
(* Pictures*)
        hexTile, altTile, thirdTile: PicHandle;

    const
(* Define constants that match our hexes *)
        kHorizontalSpacing = 32;
        kVerticalSpacing = 26;


{HexToP: Convert grid coordinates to screen coordinates}

    function HexToP (theHex, offset: Point): Point;
    begin
        HexToP.v := kVerticalSpacing * theHex.v;
        if BitAnd(theHex.v, 1) = 0 then
            HexToP.h := kHorizontalSpacing * theHex.h
        else
            HexToP.h := kHorizontalSpacing * theHex.h + kHorizontalSpacing div 2;
    end; {HexToP}


{AddToPoint: Offset a point by h,v}

    function AddToPoint (p: Point; h, v: integer): Point;
    begin
        AddToPoint.h := p.h + h;
        AddToPoint.v := p.v + v;
    end;


{MakePoint: Like SetPt but a function}

    function MakePoint (h, v: Integer): Point;
    begin
        MakePoint.h := h;
        MakePoint.v := v;
    end;


{GetNeighbor: Get a specified neighbor hex to a hex}

    function GetNeighbor (source: point; direction: integer): Point;
    begin
{Direction 0 is to the right, then clockwise}
        if BitAnd(source.v, 1) = 0 then
            case direction of
                0:
                    GetNeighbor := MakePoint(source.h + 1, source.v);
                1:
                    GetNeighbor := MakePoint(source.h, source.v + 1);
                2:
                    GetNeighbor := MakePoint(source.h - 1, source.v + 1);
                3:
                    GetNeighbor := MakePoint(source.h - 1, source.v);
                4:
                    GetNeighbor := MakePoint(source.h - 1, source.v - 1);
                5:
                    GetNeighbor := MakePoint(source.h, source.v - 1);
                otherwise
                    SysBeep(1);
            end{case}
        else
            case direction of
                0:
                    GetNeighbor := MakePoint(source.h + 1, source.v);
                1:
                    GetNeighbor := MakePoint(source.h + 1, source.v + 1);
                2:
                    GetNeighbor := MakePoint(source.h, source.v + 1);
                3:
                    GetNeighbor := MakePoint(source.h - 1, source.v);
                4:
                    GetNeighbor := MakePoint(source.h, source.v - 1);
                5:
                    GetNeighbor := MakePoint(source.h + 1, source.v - 1);
                otherwise
                    SysBeep(1);
            end;{case}
    end; {GetNeighbor}


{Dist: Calculate the squared distance between two points}

    function Dist (p1, p2: Point): Longint;
    begin
        Dist := (p1.h - p2.h) * (p1.h - p2.h) + (p1.v - p2.v) * (p1.v - p2.v);
    end;


{PToHex: For a point in screen coordinates, find the hex it is located in}

    function PToHex (thePoint, offset: Point): Point;
        var
            theHex: Point;
            p1, p2, p3: Point;
            h1, h2, h3: Point;
            d1, d2, d3: Longint; {integer?}
            junkr: rect; {debug}
    begin
{Find the hex in which "top rectangle" thePoint is located - not necessarily inside the hex}
        theHex.v := (thePoint.v - offset.v) div kVerticalSpacing;
        if BitAnd(theHex.v, 1) = 0 then
            theHex.h := (thePoint.h - offset.h) div kHorizontalSpacing
        else
            theHex.h := (thePoint.h - kHorizontalSpacing div 2 - offset.h) div kHorizontalSpacing;

{Find the three hexes that are closest to thePoint}
        h1 := theHex;                            {The lower hex}
        h2 := GetNeighbor(theHex, 4);        {The upper-left hex}
        h3 := GetNeighbor(theHex, 5);        {The upper-right hex}

{Get the center of each hex}
        p1 := AddToPoint(HexToP(h1, offset), kHorizontalSpacing div 2, kVerticalSpacing div 2);
        p2 := AddToPoint(HexToP(h2, offset), kHorizontalSpacing div 2, kVerticalSpacing div 2);
        p3 := AddToPoint(HexToP(h3, offset), kHorizontalSpacing div 2, kVerticalSpacing div 2);

        moveto(p1.h, p1.v);
        line(0, 0);
        moveto(p2.h, p2.v);
        line(0, 0);
        moveto(p3.h, p3.v);
        line(0, 0);
        junkr.topleft := HexToP(theHex, offset);
        junkr.botright := AddToPoint(HexToP(theHex, offset), kHorizontalSpacing, kVerticalSpacing);
        framerect(junkr);

{Calculate the (squared) distance from thePoint to each hex center}
        d1 := Dist(p1, thePoint);
        d2 := Dist(p2, thePoint);
        d3 := Dist(p3, thePoint);
{Pick the nearest hex!}
        if d1 < d2 then
            if d3 < d1 then {not d2}
        {d3}
                PToHex := h3
            else
        {d1}
                PToHex := h1
        else if d2 < d3 then {not d1}
    {d2}
            PToHex := h2
        else
    {d3}
            PToHex := h3;

    end; {PToHex}



(* Draw a tile *)

    procedure DrawHexTile (h: Integer; v: Integer; hexTile: PicHandle);
        var
            tileRectangle: Rect;
(* Use the picture frame *)
    begin
        tileRectangle := hexTile^^.picFrame;
(* Move it to 0,0 *)
        OffsetRect(tileRectangle, -tileRectangle.left, -tileRectangle.top);
(* Offset to the proper position *)
(* For every other line, offset a bit extra *)
        if BitAnd(v, 1) = 0 then
            OffsetRect(tileRectangle, kHorizontalSpacing * h, kVerticalSpacing * v)
        else
            OffsetRect(tileRectangle, kHorizontalSpacing * h + kHorizontalSpacing div 2, kVerticalSpacing * v);
(* Draw it *)
        DrawPicture(hexTile, tileRectangle);
    end; (*DrawHexTile*)


(* Standard inits *)

    procedure InitToolbox;
    begin
{$IFC UNDEFINED THINK_PASCAL}
        InitGraf(@qd.thePort);
        InitFonts;
        FlushEvents(everyEvent, 0);
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil);
{$ENDC}
        InitCursor;
    end;

(****************** Main program ******************)

    var
        myWindow: WindowPtr;
        windowRectangle: Rect;
        h, v: Integer;
        where: Point; {debug}
        direction: Integer;
        neighbor: Point;

begin
    InitToolbox;

(*Set up the window*)
    SetRect(windowRectangle, 50, 50, 50 + kArraySizeH * kHorizontalSpacing + kHorizontalSpacing div 2, 50 + kArraySizeV * kVerticalSpacing + kVerticalSpacing div 3);
    myWindow := NewCWindow(nil, windowRectangle, 'Hex grid demo', true, 0, WindowPtr(-1), false, 0);
    SetPort(myWindow);

(*Load the picture*)
    hexTile := GetPicture(128);            (*PICT resource #128.*)
    altTile := GetPicture(129);
    thirdTile := GetPicture(130);

(*Draw all tiles!*)
    for h := 0 to kArraySizeH - 1 do
        for v := 0 to kArraySizeV - 1 do
            DrawHexTile(h, v, hexTile);

    while not Button do
        ;

{Demonstrate PToHex by drawing the hex in which the mouse is}

    GetMouse(where);
    where := PToHex(where, Point(0));

    while Button do
        ;

    DrawHexTile(where.h, where.v, altTile);

{Demonstrate GetNeighbor by drawing the neighbors as well}

    for direction := 0 to 5 do
        begin
            neighbor := GetNeighbor(where, direction);
            DrawHexTile(neighbor.h, neighbor.v, thirdTile);
        end;

    while not Button do
        ;

end. (*TextGrid*)